﻿'这主要是为VFB工程标签开发的TAB
'第一个标签是主页，永远固定。后面的可以任意拖动交换位置，还可以拖出到外面（删除这个标签）由事件接管成为独立窗口。
'注意：这个不支持1个窗口多开，因为TAB数据保存在公共区，想支持多开，需要私有化保存。
Type YFproTabData 'TAB数据
   vWnd  As hWnd  '被控制的窗口
   vName As CWSTR '显示的名称
   vTip  As CWSTR '要提示的文本
   vIco  As Long  '显示的字体图标，字体名是 ICONFONT
   X     As Long  'Tab 显示的开始位置 少于0 表示不显示，因为当项目太多不够显示时，有的就不显示了
   W     As Long  'Tab 显示的宽度，由显示时计算设置
End Type
Type YFproTab
   Private : '私有区
   Index    As Long = -1 '当前选择的TAB
   TabAdd   As YFproTabData '新增TAB按钮
   TabDown  As YFproTabData 'Tab下拉列表按钮
   TabMouse As Long         '鼠标在那个按钮上，0表示不在按钮上，1开始在按钮上。
   TabPress As Long         '鼠标是不是按下
   TabClose As Long         '鼠标是不是在关闭上
   ToolWnd  As hWnd         '工具提示窗口句柄
   Declare Function Tab_GetAn(xPos As Long ,yPos As Long) As Long '根据鼠标位置，返回按钮，0表示不在按钮上，1开始在按钮上。
   Public : '公共区
   hWndForm     As hWnd '控件属于那个窗口的窗口句柄
   hWndControl  As hWnd '本控件的窗口句柄
   cBack        As Long = &HDA8A22 '背景色
   cWord        As Long = &HE0E0E0 '字色
   cMove        As Long = &H9C6319 '鼠标移动后背景色
   cSelBack     As Long = &H3B3B3B '选择背景色
   cSelWord     As Long = &HE0E0E0 '选择色
   mLeft        As Long         '被控制的窗口，被切换到前台时，总是设置这些位置，相对于父窗口位置 hWndForm
   mTop         As Long         '
   mWidth       As Long         '
   mHeight      As Long         '
   TabData(Any) As YFproTabData 'TAB数据,不可以多线程读写，可能会发生崩溃的。
   
   Declare Function MsgProcedure(hWndForm As hWnd ,wMsg As UInteger ,nwParam As wParam ,nlParam As lParam) As LResult '消息处理（控件自用）
   Declare Sub TabPainting(hWndForm As hWnd) ' 绘画（控件自用）
   Declare Sub SetColour(nBack As Long = -1 ,nWord As Long = -1 ,nMove As Long = -1 ,nSelBack As Long = -1 ,nSelWord As Long = -1) '设置颜色，设置-1为不修改
   Declare Sub SetPosAndSize(nLeft As Long ,nTop As Long ,nWidth As Long ,nHeight As Long) '设置被控制的窗口，被切换到前台时位置和大小
   Declare Function AddTab(vWnd As hWnd ,vName As CWSTR ,vTip As CWSTR ,vIco As Long = 0) As Long ' 添加一个新窗口，返回该TAB的索引，失败返回-1
   Declare Property Selected() As Long '返回或设置 当前选择的TAB
   Declare Property Selected(vIndex As Long)
   Declare Function remove(vIndex As Long) As Long '删除一个TAB，只移除关联窗口句柄，不负责窗口句柄销毁 ，成功返回非0，失败返回0
   Declare Function RemoveAll()            As Long '删除所有选项卡,如果成功返回删除个数，否则返回0。只移除关联窗口句柄，不负责窗口句柄销毁 ，成功返回非0，失败返回0
End Type

Dim Shared TabData(Any) As YFproTabData

Function YFproTab.MsgProcedure(hWndForm As hWnd ,wMsg As UInteger ,nwParam As wParam ,nlParam As lParam) As LResult
   Select Case wMsg
      Case WM_PAINT
         This.TabPainting(hWndForm)
         Return True
      Case WM_USER + 200 '删除操作
         Dim vIndex As Long = nlParam
         If vIndex > -1 AndAlso vIndex <= UBound(TabData) Then
            If SendMessage(hWndControl ,WM_USER + 100 ,0 ,vIndex) <> 0 Then Return 0 '发送删除事件
            Dim u As Long = UBound(TabData) ,i As Long
            If vIndex < u Then
               For i = vIndex To u -1
                  TabData(i) = TabData(i + 1)
               Next
            End If
            If u = 0 Then
               Erase TabData
            Else
               u -= 1
               ReDim Preserve TabData(u)
            End If
            vIndex = Index
            If vIndex > UBound(TabData) Then vIndex = UBound(TabData)
            This.Selected = vIndex
            Return -1
         Else
            Return 0
         End If
      Case WM_USER + 201 '删除所有
         Dim jj As Long
         If UBound(TabData) > -1 Then
            Dim u          As Long = UBound(TabData) ,i As Long ,ti As Long
            Dim sTabData() As YFproTabData
            ReDim sTabData(u)
            For i = 0 To u
               If SendMessage(hWndControl ,WM_USER + 100 ,0 ,i) <> 0 Then '发送删除事件
                  sTabData(ti) = TabData(i) '可能遇到不允许删除的项目
                  ti           += 1
               Else
                  jj += 1
               End If
            Next
            If ti Then '遇到不允许删除的项目
               ti -= 1
               ReDim TabData(ti)
               For i = 0 To ti
                  TabData(i) = sTabData(i)
               Next
               This.Selected = 0
            Else
               Erase TabData
            End If
         End If
         This.Selected = -1
         FF_Redraw hWndForm
         Return jj
      Case WM_USER + 202 '新增
         Dim n As YFproTabData Ptr = Cast(Any Ptr ,nlParam)
         If n = 0 Then Return -1
         Dim u As Long = UBound(TabData) ,i As Long
         If u > -1 Then
            For i = 0 To u
               FF_Control_ShowState(TabData(i).vWnd ,SW_HIDE)
            Next
         End If
         i = u + 1
         ReDim Preserve TabData(i)
         TabData(i) = *n
         FF_Control_SetLocSize(n->vWnd ,mLeft ,mTop ,mWidth ,mHeight)
         FF_Control_ShowState(n->vWnd ,SW_SHOW)
         Index    = i
         Function = i
      Case WM_MOUSEMOVE
         Dim entTrack As tagTRACKMOUSEEVENT
         entTrack.cbSize      = SizeOf(tagTRACKMOUSEEVENT)
         entTrack.dwFlags     = TME_LEAVE
         entTrack.hwndTrack   = hWndControl
         entTrack.dwHoverTime = HOVER_DEFAULT
         TrackMouseEvent @entTrack
         Dim As Long xPos = GET_X_LPARAM(nlParam) ,yPos = GET_Y_LPARAM(nlParam) ,MouseFlags = nwParam
         Dim mm As Long = TabClose
         Dim aa As Long = Tab_GetAn(xPos ,yPos)
         Dim bb As Long = MouseFlags = 1
         If bb Then
            
         Else
            If aa <> TabMouse Or TabPress <> bb Or mm <> TabClose Then
               TabMouse = aa
               TabPress = bb
               FF_Redraw hWndForm
               aa -= 1
               If IsWindow(ToolWnd) Then DestroyWindow ToolWnd
               If aa >= 0 And aa <= UBound(TabData) Then
                  if TabClose then
                     ToolWnd = FF_AddTooltip(hWndForm ,"关闭这个标签" ,1)
                  Else
                     If Len(TabData(aa).vTip) Then
                        ToolWnd = FF_AddTooltip(hWndForm ,TabData(aa).vTip ,1)
                     End If
                  End If
                  'ElseIf aa = 10000 Then
                  '   ToolWnd = FF_AddTooltip(hWndForm ,"新增" ,1)
                  'ElseIf aa = 10001 Then
                  '   ToolWnd = FF_AddTooltip(hWndForm ,"下拉列表" ,1)
               End If
            End If
         End If
      Case WM_MOUSELEAVE
         TabMouse = 0
         TabPress = 0
         TabClose = 0
         FF_Redraw hWndForm
      Case WM_LBUTTONDOWN
         Dim As Long xPos = GET_X_LPARAM(nlParam) ,yPos = GET_Y_LPARAM(nlParam) ,MouseFlags = nwParam
         Dim aa As Long = Tab_GetAn(xPos ,yPos)
         Dim bb As Long = True
         If aa <> TabMouse Or TabPress <> bb Then
            TabMouse = aa
            TabPress = bb
            FF_Redraw hWndForm
         End If
      Case WM_LBUTTONUP
         Dim As Long xPos = GET_X_LPARAM(nlParam) ,yPos = GET_Y_LPARAM(nlParam) ,MouseFlags = nwParam
         Dim aa As Long = Tab_GetAn(xPos ,yPos) ,bb As Long
         If aa = TabMouse And TabPress <> 0 Then
            If aa < 10000 Then
               If aa > 0 And aa <= UBound(TabData) + 1 Then
                  If TabClose Then
                     If SendMessage(hWndControl ,WM_USER + 105 ,0 ,aa -1) = 0 Then '即将关闭标签事件，返回非零不允许切换
                        This.remove(aa -1)
                     End If
                  Else
                     If SendMessage(hWndControl ,WM_USER + 101 ,Index ,aa -1) = 0 Then '即将切换标签事件，返回非零不允许切换
                        This.Selected = aa -1
                     End If
                  End If
               End If
            ElseIf aa = 10000 Then
               SendMessage(hWndControl ,WM_USER + 103 ,0 ,0) '点击了新增按钮事件
            ElseIf aa = 10001 Then
               If SendMessage(hWndControl ,WM_USER + 104 ,0 ,0) = 0 Then '点击了下拉列表按钮事件，返回非零不允许显示下拉列表
                  Dim u As Long = UBound(TabData)
                  If u > -1 Then
                     Dim zMenu As HMENU = CreatePopupMenu
                     Dim tFont As HFONT
                     If IsVista Then
                        If AfxScaleX(1) = 1 Then
                           tFont = AfxCreateFont("ICONFONT" ,12 , -1)
                        Else
                           tFont = AfxCreateFont("ICONFONT" ,11 , -1)
                        End If
                     Else
                        tFont = AfxCreateFont("ICONFONT" ,10 , -1)
                     End If
                     Dim i As Long
                     For i = 0 To u
                        AddMenuText(zMenu ,i + 100 ,TabData(i).vName ,tFont ,TabData(i).vIco ,0)
                     Next
                     Dim Pm As Point
                     GetCursorPos @Pm
                     Dim id As Long = TrackPopupMenu(zMenu ,TPM_RETURNCMD Or TPM_NONOTIFY ,Pm.x - AfxScaleX(20) ,Pm.y + AfxScaleX(20) ,0 ,hWndControl ,NULL) '比方说弹出菜单
                     if id > 99 Then
                        If SendMessage(hWndControl ,WM_USER + 101 ,Index ,id -100) = 0 Then '即将切换标签事件，返回非零不允许切换
                           This.Selected = id -100
                        End If
                     End if
                     DeleteObject tFont
                     DestroyMenu zMenu
                  End If
               End If
            End If
            TabMouse = 0
            TabPress = 0
            FF_Redraw hWndForm
         Else
            If aa <> TabMouse Or TabPress <> bb Then
               TabMouse = aa
               TabPress = bb
               FF_Redraw hWndForm
            End If
         End If
   End Select
   Function = 0
End Function
Sub YFproTab.TabPainting(hWndForm As hWnd) ' 绘画
   Dim gg As yGDI = yGDI(hWndControl ,cBack ,True) 'WM_PAINT事件里必须用这行初始化 yGDI
   Dim u  As Long = UBound(TabData)
   If u = -1 Then Return
   Dim ww As Long = AfxUnscaleX(gg.m_Width) ,hh As Long = AfxUnscaleY(gg.m_Height)
   Dim i  As Long ,x As Long ,y As Long ,aw As Long ,bw As Long
   y = 2
   x = 2
   gg.SetColor cWord
   gg.Pen 1 ,cWord
   gg.Brush
   
   For i = 0 To u
      aw = gg.GetTextWidth(TabData(i).vName)
      If TabData(i).vIco Then aw += 20
      aw += 15 '这里是标签2个空边
      If i = 0 Then
         '主页的宽度，固定不变
         bw = (ww -60 - aw) / u '平均宽度，当有标签超过平均，就限制为平均宽度
         If bw < 25 Then bw = 25
      Else
         If aw > bw   Then aw = bw
         If i = Index Then aw += 15 '关闭按钮
      End If
      TabData(i).W = aw
      TabData(i).x = x
      If x + aw > ww -30 Then
         For ii As Long = i To u
            TabData(ii).x = -1
         Next
         Exit For
      end if
      
      If i = Index Then
         gg.SetColor cSelWord
         gg.Pen 0 ,0
         gg.Brush cSelBack
         gg.DrawFrame x ,y ,aw ,28
      Else
         If i + 1 = TabMouse Then
            gg.Pen 0 ,0
            
            gg.Brush IIf(TabPress ,cSelBack ,cMove)
            gg.SetColor IIf(TabPress ,cSelWord ,cWord)
            gg.DrawFrame IIf(i = Index + 1 ,x ,x + 1) ,y ,aw ,28
         End If
         'TabPress = bb
      End If
      gg.DrawTextS x + 25 ,y ,aw - IIf(i = Index And index > 0 ,40 ,25) ,28 ,TabData(i).vName ,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE Or DT_NOPREFIX Or DT_WORD_ELLIPSIS
      If TabData(i).vIco Then
         gg.Font "iconfont" ,12
         gg.DrawTextS x + 5 ,y ,20 ,28 ,WChr(TabData(i).vIco) ,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
         gg.Font
      End If
      x += aw
      If i = Index Then
         If Index > 0 Then
            If TabClose Then
               gg.gpPen 0 ,0
               gg.gpBrush ColorGdiToGDIplue(IIf(TabPress ,cBack,cSelWord))
               gg.gpDrawEllipse x -16 ,y + 7 ,15 ,15
               gg.Pen 2 ,ColorGdiToGDIplue(IIf(TabPress ,cWord  ,cSelBack))
            Else
               gg.Pen 2 ,cSelWord
            End If
            gg.DrawLine x -13 ,y + 10 ,x -5  ,y + 18
            gg.DrawLine x -5  ,y + 10 ,x -13 ,y + 18
         End If
         gg.SetColor cWord
         gg.Pen 1 ,cWord
         gg.Brush
      Else
         If i + 1 = TabMouse Then
            gg.Pen 1 ,cWord
            gg.Brush
         End If
         gg.DrawLine x ,y + 6 ,x ,y + 22
      End If
   Next
   
   x        += 6
   TabAdd.W = 16
   TabAdd.x = x -3
   If TabMouse = 10000 Then
      gg.gpPen 0 ,0
      gg.gpBrush ColorGdiToGDIplue(IIf(TabPress ,cSelBack ,cMove))
      gg.gpDrawEllipse x -4 ,y + 5 ,18 ,18
      gg.gpPen 2 ,ColorGdiToGDIplue(IIf(TabPress ,cSelWord ,cWord))
   Else
      gg.gpPen 2 ,ColorGdiToGDIplue(cWord)
   End If
   
   gg.gpDrawLine x ,y + 14 ,x + 10 ,y + 14
   gg.gpDrawLine x + 5 ,y + 9 ,x + 5 ,y + 19
   
   TabDown.W = 16
   TabDown.x = ww -17
   gg.gpPen 0 ,0
   If TabMouse = 10001 Then
      gg.gpBrush ColorGdiToGDIplue(IIf(TabPress ,cSelBack ,cMove))
      gg.GpDrawFrame TabDown.x + 1 ,y ,15 ,28
      gg.gpBrush ColorGdiToGDIplue(IIf(TabPress ,cSelWord ,cWord))
   Else
      gg.GpBrush ColorGdiToGDIplue(cWord)
   End If
   
   Dim POINTS(2) As Point
   POINTS(0).x = ww -14
   POINTS(0).y = y  + 15
   POINTS(1).x = ww - 3
   POINTS(1).y = y  + 15
   POINTS(2).x = ww -8
   POINTS(2).y = y + 24
   gg.GpDrawPolygon POINTS()
   
End Sub
Sub YFproTab.SetColour(nBack As Long = -1 ,nWord As Long = -1 ,nMove As Long = -1 ,nSelBack As Long = -1 ,nSelWord As Long = -1) '设置颜色
   If nBack <> -1    Then cBack    = nBack
   If nWord <> -1    Then cWord    = nWord
   If nMove <> -1    Then cMove    = nMove
   If nSelBack <> -1 Then cSelBack = nSelWord
   If nSelWord <> -1 Then cSelWord = nSelWord
   FF_Redraw(hWndControl)
End Sub

Sub YFproTab.SetPosAndSize(nLeft As Long ,nTop As Long ,nWidth As Long ,nHeight As Long) '设置被控制的窗口，被切换到前台时位置和大小
   mLeft   = nLeft
   mTop    = nTop
   mWidth  = nWidth
   mHeight = nHeight
   If Index > -1 AndAlso Index <= UBound(TabData) Then
      FF_Control_SetLocSize(TabData(Index).vWnd  ,nLeft ,nTop ,nWidth ,nHeight)
   End If
End Sub
Function YFproTab.AddTab(vWnd As hWnd ,vName As CWSTR ,vTip As CWSTR ,vIco As Long = 0) As Long ' 添加一个新窗口，返回该TAB的索引，失败返回-1
   If IsWindow(hWndControl) = 0 Then Return 0
   Dim n As YFproTabData
   n.vWnd   = vWnd
   n.vName  = vName
   n.vTip   = vTip
   n.vIco   = vIco
   Function = SendMessage(hWndControl ,WM_USER + 202 ,0 ,Cast(LPARAM ,@n)) '为了避免多线程操作控件发生崩溃，需要走消息，简单又方便解决这问题
   
End Function
Property YFproTab.Selected() As Long
   Property = Index
End Property
Property YFproTab.Selected(vIndex As Long) '给属性赋值
   If vIndex > -1 AndAlso vIndex <= UBound(TabData) Then
      Dim ss As Long = Index
      If ss > -1 AndAlso ss <= UBound(TabData) Then FF_Control_ShowState(TabData(ss).vWnd ,SW_HIDE)
      Index = vIndex
      FF_Control_SetLocSize(TabData(vIndex).vWnd ,mLeft ,mTop ,mWidth ,mHeight)
      FF_Control_ShowState(TabData(vIndex).vWnd ,SW_SHOW)
      SendMessage(hWndControl ,WM_USER + 102 ,ss ,vIndex) '切换标签后事件
   End If
   
End Property
Function YFproTab.remove(vIndex As Long) As Long '删除一个TAB
   If IsWindow(hWndControl) = 0 Then Return 0
   Function = SendMessage(hWndControl ,WM_USER + 200 ,0 ,vIndex) '为了避免多线程操作控件发生崩溃，需要走消息，简单又方便解决这问题
End Function
Function YFproTab.RemoveAll() As Long '删除
   If IsWindow(hWndControl) = 0 Then Return 0
   Function = SendMessage(hWndControl ,WM_USER + 201 ,0 ,0) '为了避免多线程操作控件发生崩溃，需要走消息，简单又方便解决这问题   
End Function
Function YFproTab.Tab_GetAn(xPos As Long ,yPos As Long) As Long
   If IsWindow(hWndControl) = 0 Then Return 0
   Dim u As Long = UBound(TabData)
   If u = -1 Then Return 0
   Dim i As Long
   xPos     = AfxUnscaleX(xPos)
   yPos     = AfxUnscaleY(yPos)
   TabClose = 0
   For i = 0 To u
      If xPos >= TabData(i).X And xPos <= TabData(i).X + TabData(i).W Then
         If xPos > TabData(i).X + TabData(i).W -13 AndAlso i>0 AndAlso  i=Index  Then TabClose = -1
         Return i + 1
      End If
   Next
   'if yPos > 5 And yPos < 25 Then
   If xPos >= TabAdd.X And xPos <= TabAdd.X + TabAdd.W    Then Return 10000
   If xPos >= TabDown.X And xPos <= TabDown.X + TabDown.W Then Return 10001
   'End If
   
End Function


